Happy Moments

Arpita Shah and Tian Zheng

HappyDB is a corpus of 100,000 crowd-sourced happy moments via Amazon’s Mechanical Turk. You can read more about it on https://arxiv.org/abs/1801.07746.

Here, we explore this data set and try to answer the question, “What makes people happy?”

Step 0 - Load all the required libraries

From the packages’ descriptions:

library(tidyverse)
library(tidytext)
library(DT)
library(scales)
library(wordcloud2)
library(gridExtra)
library(ngram)
library(shiny) 
library(ggraph)
library(igraph)

Step 1 - Load the processed text data along with demographic information on contributors

We use the processed data for our analysis and combine it with the demographic information available.

hm_data <- read_csv("../output/processed_moments.csv")
urlfile<-'https://raw.githubusercontent.com/rit-public/HappyDB/master/happydb/data/demographic.csv'
demo_data <- read_csv(urlfile)

Combine both the data sets and keep the required columns for analysis

We select a subset of the data that satisfies specific row conditions.

hm_data <- hm_data %>%
  inner_join(demo_data, by = "wid") %>%
  select(wid,
         original_hm,
         gender, 
         marital, 
         parenthood,
         reflection_period,
         age, 
         country, 
         ground_truth_category, 
         text) %>%
  mutate(count = sapply(hm_data$text, wordcount)) %>%
  filter(gender %in% c("m", "f")) %>%
  filter(marital %in% c("single", "married")) %>%
  filter(parenthood %in% c("n", "y")) %>%
  filter(reflection_period %in% c("24h", "3m")) %>%
  mutate(reflection_period = fct_recode(reflection_period, 
                                        months_3 = "3m", hours_24 = "24h"))
datatable(hm_data)
It seems your data is too big for client-side DataTables. You may consider server-side processing: https://rstudio.github.io/DT/server.htmlIt seems your data is too big for client-side DataTables. You may consider server-side processing: https://rstudio.github.io/DT/server.html

Create a bag of words using the text data

bag_of_words <-  hm_data %>%
  unnest_tokens(word, text)
word_count <- bag_of_words %>%
  count(word, sort = TRUE)

Create bigrams using the text data

hm_bigrams <- hm_data %>%
  filter(count != 1) %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)
bigram_counts <- hm_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  count(word1, word2, sort = TRUE)

Specify the user interface for the R Shiny app

We want each tab to have its own controls for input and so Shiny’s “navbarPage()” layout works the best. We have the first tab visualizing the overall data, second one for scatterplots comparing the proportion of words within categories, third one highlighting the most frequently appearing bigrams based on categories and the last tab to explore the actual happy moments.

ui <- navbarPage("What makes people happy?",
                 tabPanel("Overview",
                          
                          titlePanel(h1("Most Frequent Occurrences",
                                        align = "center")),
                          
                          sidebarLayout(
                            sidebarPanel(
                              sliderInput(inputId = "topWordcloud",
                                          label = "Number of terms for word cloud:",
                                          min = 5,
                                          max = 100,
                                          value = 50),
                              br(),
                              br(),
                              
                              checkboxInput(inputId = "topFreqB",
                                            label = "Plot Bar Chart",
                                            value = F),
                              sliderInput(inputId = "topBarchart",
                                          label = "Number of terms for bar chart:",
                                          min = 1,
                                          max = 25,
                                          value = 10),
                              br(),
                              br(),
                              
                              checkboxInput(inputId = "topFreqN",
                                            label = "Plot Network Graph",
                                            value = F),
                              sliderInput(inputId = "topNetwork",
                                          label = "Number of edges for network graph:",
                                          min = 1,
                                          max = 150,
                                          value = 50)
                            ),
                            
                            mainPanel(
                              wordcloud2Output(outputId = "WC"),
                              plotOutput(outputId = "figure")
                            )
                          )
                 ),
                 
                 tabPanel("Individual Terms",
                          
                          titlePanel(h1("Comparison of Proportions",
                                        align = "center")),
                          
                          sidebarLayout(
                            sidebarPanel(
                              selectInput(inputId = "attribute",
                                          label = "Select the attribute:",
                                          choices = c("Gender" = "gender",
                                                      "Marital Status" = "marital",
                                                      "Parenthood" = "parenthood",
                                                      "Reflection Period" = "reflection_period")
                              )
                            ),
                            
                            mainPanel(
                              plotOutput(outputId = "scatter")
                            )
                          )
                 ),
                 
                 tabPanel("Pair of Words",
                          
                          titlePanel(h1("Most Frequent Bigrams",
                                        align = "center")),
                          
                          sidebarLayout(
                            sidebarPanel(
                              selectInput(inputId = "factor",
                                          label = "Select the attribute:",
                                          choices = c("Gender" = "gender",
                                                      "Marital Status" = "marital",
                                                      "Parenthood" = "parenthood",
                                                      "Reflection Period" = "reflection_period")
                              ),
                              numericInput(inputId = "topBigrams",
                                          label = "Number of top pairs to view:",
                                          min = 1,
                                          max = 25,
                                          value = 10)
                            ),
                            
                            mainPanel(
                              plotOutput(outputId = "bar")
                            )
                          )
                 ),
                 
                 tabPanel("Data",
                          DT::dataTableOutput("table")
                          )
)

Develop the server for the R Shiny app

This shiny app visualizes summary of data and displays the data table itself.

server <- function(input, output, session) {
  
  pt1 <- reactive({
    if(!input$topFreqB) return(NULL)
    word_count %>%
      slice(1:input$topBarchart) %>%
      mutate(word = reorder(word, n)) %>%
      ggplot(aes(word, n)) +
      geom_col() +
      xlab(NULL) +
      ylab("Word Frequency")+
      coord_flip()
  })
  
  pt2 <- reactive({
    if(!input$topFreqN) return(NULL)
    bigram_graph <- bigram_counts %>%
      slice(1:input$topNetwork) %>%
      graph_from_data_frame()
    
    set.seed(123)
    
    x <- grid::arrow(type = "closed", length = unit(.1, "inches"))
    
    ggraph(bigram_graph, layout = "fr") +
      geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                     arrow = x, end_cap = circle(.05, 'inches')) +
      geom_node_point(color = "skyblue", size = 3) +
      geom_node_text(aes(label = name), repel = TRUE) +
      theme_void()
  })
  
  output$WC <- renderWordcloud2({
    
    word_count %>%
      slice(1:input$topWordcloud) %>%
      wordcloud2(size = 0.6,
                 rotateRatio = 0)
    
  })
  
  output$figure <- renderPlot(height = 500, width = 500, {
    
    ptlist <- list(pt1(),pt2())
    ptlist <- ptlist[!sapply(ptlist, is.null)]
    if(length(ptlist)==0) return(NULL)
    
    lay <- rbind(c(1,1),
                 c(2,2))
    
    grid.arrange(grobs = ptlist, layout_matrix = lay)
  })
  
  
  
  selectedAttribute <- reactive({
    list(atr = input$attribute)
  })
  
  output$scatter <- renderPlot({
    temp <- bag_of_words %>%
      count(!!as.name(selectedAttribute()$atr), word) %>%
      group_by(!!as.name(selectedAttribute()$atr)) %>%
      mutate(proportion = n / sum(n)) %>% 
      select(-n) %>% 
      spread(!!as.name(selectedAttribute()$atr), proportion)
    
      ggplot(temp, 
             aes_string(x = colnames(temp)[2], y = colnames(temp)[3]),
             color = abs(colnames(temp)[3] - colnames(temp)[2])) +
      geom_abline(color = "gray40", lty = 2) +
      geom_jitter(alpha = 0.1, size = 1, width = 0.3, height = 0.3) +
      geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +
      scale_x_log10(labels = percent_format()) +
      scale_y_log10(labels = percent_format()) +
      scale_color_gradient(limits = c(0, 0.001), low = "darkslategray4", high = "gray75") +
      theme(legend.position="none")
  })
  
  
  
  selectedBigram <- reactive({
    list(var = input$factor)
  })
  
  output$bar <- renderPlot({
    hm_bigrams %>%
      count(!!as.name(selectedBigram()$var), bigram, sort = TRUE) %>%
      group_by(!!as.name(selectedBigram()$var)) %>%
      top_n(input$topBigrams) %>%
      ungroup() %>%
      mutate(bigram = reorder(bigram, n)) %>%
      ggplot(aes(bigram, n, fill = !!as.name(selectedBigram()$var))) +
      geom_col(show.legend = FALSE) +
      facet_wrap(as.formula(paste("~", selectedBigram()$var)), ncol = 2, scales = "free") +
      coord_flip()
  })
  
  
  output$table <- DT::renderDataTable({
    DT::datatable(hm_data)
  })
}

Run the R Shiny app

shinyApp(ui, server)
LS0tDQp0aXRsZTogIkhhcHB5IE1vbWVudHMiDQphdXRob3I6ICJBcnBpdGEgU2hhaCBhbmQgVGlhbiBaaGVuZyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KcnVudGltZTogc2hpbnkNCi0tLQ0KDQpIYXBweURCIGlzIGEgY29ycHVzIG9mIDEwMCwwMDAgY3Jvd2Qtc291cmNlZCBoYXBweSBtb21lbnRzIHZpYSBBbWF6b24ncyBNZWNoYW5pY2FsIFR1cmsuIFlvdSBjYW4gcmVhZCBtb3JlIGFib3V0IGl0IG9uIGh0dHBzOi8vYXJ4aXYub3JnL2Ficy8xODAxLjA3NzQ2Lg0KDQpIZXJlLCB3ZSBleHBsb3JlIHRoaXMgZGF0YSBzZXQgYW5kIHRyeSB0byBhbnN3ZXIgdGhlIHF1ZXN0aW9uLCAiV2hhdCBtYWtlcyBwZW9wbGUgaGFwcHk/Ig0KDQojIyMgU3RlcCAwIC0gTG9hZCBhbGwgdGhlIHJlcXVpcmVkIGxpYnJhcmllcw0KDQpGcm9tIHRoZSBwYWNrYWdlcycgZGVzY3JpcHRpb25zOg0KDQorIGB0aWR5dmVyc2VgIGlzIGFuIG9waW5pb25hdGVkIGNvbGxlY3Rpb24gb2YgUiBwYWNrYWdlcyBkZXNpZ25lZCBmb3IgZGF0YSBzY2llbmNlLiBBbGwgcGFja2FnZXMgc2hhcmUgYW4gdW5kZXJseWluZyBkZXNpZ24gcGhpbG9zb3BoeSwgZ3JhbW1hciwgYW5kIGRhdGEgc3RydWN0dXJlczsNCisgYHRpZHl0ZXh0YCBhbGxvd3MgdGV4dCBtaW5pbmcgdXNpbmcgJ2RwbHlyJywgJ2dncGxvdDInLCBhbmQgb3RoZXIgdGlkeSB0b29sczsNCisgYERUYCBwcm92aWRlcyBhbiBSIGludGVyZmFjZSB0byB0aGUgSmF2YVNjcmlwdCBsaWJyYXJ5IERhdGFUYWJsZXM7DQorIGBzY2FsZXNgIG1hcCBkYXRhIHRvIGFlc3RoZXRpY3MsIGFuZCBwcm92aWRlIG1ldGhvZHMgZm9yIGF1dG9tYXRpY2FsbHkgZGV0ZXJtaW5pbmcgYnJlYWtzIGFuZCBsYWJlbHMgZm9yIGF4ZXMgYW5kIGxlZ2VuZHM7DQorIGB3b3JkY2xvdWQyYCBwcm92aWRlcyBhbiBIVE1MNSBpbnRlcmZhY2UgdG8gd29yZGNsb3VkIGZvciBkYXRhIHZpc3VhbGl6YXRpb247DQorIGBncmlkRXh0cmFgIGNvbnRhaW5zIG1pc2NlbGxhbmVvdXMgZnVuY3Rpb25zIGZvciAiZ3JpZCIgZ3JhcGhpY3M7DQorIGBuZ3JhbWAgaXMgZm9yIGNvbnN0cnVjdGluZyBuLWdyYW1zICjigJx0b2tlbml6aW5n4oCdKSwgYXMgd2VsbCBhcyBnZW5lcmF0aW5nIG5ldyB0ZXh0IGJhc2VkIG9uIHRoZSBuLWdyYW0gc3RydWN0dXJlIG9mIGEgZ2l2ZW4gdGV4dCBpbnB1dCAo4oCcYmFiYmxpbmfigJ0pOw0KKyBgU2hpbnlgIGlzIGFuIFIgcGFja2FnZSB0aGF0IG1ha2VzIGl0IGVhc3kgdG8gYnVpbGQgaW50ZXJhY3RpdmUgd2ViIGFwcHMgc3RyYWlnaHQgZnJvbSBSOw0KDQpgYGB7ciBsb2FkIGxpYnJhcmllcywgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCg0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KHRpZHl0ZXh0KQ0KbGlicmFyeShEVCkNCmxpYnJhcnkoc2NhbGVzKQ0KbGlicmFyeSh3b3JkY2xvdWQyKQ0KbGlicmFyeShncmlkRXh0cmEpDQpsaWJyYXJ5KG5ncmFtKQ0KbGlicmFyeShzaGlueSkgDQpsaWJyYXJ5KGdncmFwaCkNCmxpYnJhcnkoaWdyYXBoKQ0KYGBgDQoNCiMjIyBTdGVwIDEgLSBMb2FkIHRoZSBwcm9jZXNzZWQgdGV4dCBkYXRhIGFsb25nIHdpdGggZGVtb2dyYXBoaWMgaW5mb3JtYXRpb24gb24gY29udHJpYnV0b3JzDQoNCldlIHVzZSB0aGUgcHJvY2Vzc2VkIGRhdGEgZm9yIG91ciBhbmFseXNpcyBhbmQgY29tYmluZSBpdCB3aXRoIHRoZSBkZW1vZ3JhcGhpYyBpbmZvcm1hdGlvbiBhdmFpbGFibGUuDQoNCmBgYHtyIGxvYWQgZGF0YSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmhtX2RhdGEgPC0gcmVhZF9jc3YoIi4uL291dHB1dC9wcm9jZXNzZWRfbW9tZW50cy5jc3YiKQ0KDQp1cmxmaWxlPC0naHR0cHM6Ly9yYXcuZ2l0aHVidXNlcmNvbnRlbnQuY29tL3JpdC1wdWJsaWMvSGFwcHlEQi9tYXN0ZXIvaGFwcHlkYi9kYXRhL2RlbW9ncmFwaGljLmNzdicNCmRlbW9fZGF0YSA8LSByZWFkX2Nzdih1cmxmaWxlKQ0KYGBgDQoNCiMjIyBDb21iaW5lIGJvdGggdGhlIGRhdGEgc2V0cyBhbmQga2VlcCB0aGUgcmVxdWlyZWQgY29sdW1ucyBmb3IgYW5hbHlzaXMNCg0KV2Ugc2VsZWN0IGEgc3Vic2V0IG9mIHRoZSBkYXRhIHRoYXQgc2F0aXNmaWVzIHNwZWNpZmljIHJvdyBjb25kaXRpb25zLg0KDQpgYGB7ciBjb21iaW5pbmcgZGF0YSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmhtX2RhdGEgPC0gaG1fZGF0YSAlPiUNCiAgaW5uZXJfam9pbihkZW1vX2RhdGEsIGJ5ID0gIndpZCIpICU+JQ0KICBzZWxlY3Qod2lkLA0KICAgICAgICAgb3JpZ2luYWxfaG0sDQogICAgICAgICBnZW5kZXIsIA0KICAgICAgICAgbWFyaXRhbCwgDQogICAgICAgICBwYXJlbnRob29kLA0KICAgICAgICAgcmVmbGVjdGlvbl9wZXJpb2QsDQogICAgICAgICBhZ2UsIA0KICAgICAgICAgY291bnRyeSwgDQogICAgICAgICBncm91bmRfdHJ1dGhfY2F0ZWdvcnksIA0KICAgICAgICAgdGV4dCkgJT4lDQogIG11dGF0ZShjb3VudCA9IHNhcHBseShobV9kYXRhJHRleHQsIHdvcmRjb3VudCkpICU+JQ0KICBmaWx0ZXIoZ2VuZGVyICVpbiUgYygibSIsICJmIikpICU+JQ0KICBmaWx0ZXIobWFyaXRhbCAlaW4lIGMoInNpbmdsZSIsICJtYXJyaWVkIikpICU+JQ0KICBmaWx0ZXIocGFyZW50aG9vZCAlaW4lIGMoIm4iLCAieSIpKSAlPiUNCiAgZmlsdGVyKHJlZmxlY3Rpb25fcGVyaW9kICVpbiUgYygiMjRoIiwgIjNtIikpICU+JQ0KICBtdXRhdGUocmVmbGVjdGlvbl9wZXJpb2QgPSBmY3RfcmVjb2RlKHJlZmxlY3Rpb25fcGVyaW9kLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtb250aHNfMyA9ICIzbSIsIGhvdXJzXzI0ID0gIjI0aCIpKQ0KYGBgDQoNCmBgYHtyfQ0KZGF0YXRhYmxlKGhtX2RhdGEpDQpgYGANCiMjIyBDcmVhdGUgYSBiYWcgb2Ygd29yZHMgdXNpbmcgdGhlIHRleHQgZGF0YQ0KDQpgYGB7ciBiYWcgb2Ygd29yZHMsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9DQpiYWdfb2Zfd29yZHMgPC0gIGhtX2RhdGEgJT4lDQogIHVubmVzdF90b2tlbnMod29yZCwgdGV4dCkNCg0Kd29yZF9jb3VudCA8LSBiYWdfb2Zfd29yZHMgJT4lDQogIGNvdW50KHdvcmQsIHNvcnQgPSBUUlVFKQ0KYGBgDQoNCiMjIyBDcmVhdGUgYmlncmFtcyB1c2luZyB0aGUgdGV4dCBkYXRhDQoNCmBgYHtyIGJpZ3JhbSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmhtX2JpZ3JhbXMgPC0gaG1fZGF0YSAlPiUNCiAgZmlsdGVyKGNvdW50ICE9IDEpICU+JQ0KICB1bm5lc3RfdG9rZW5zKGJpZ3JhbSwgdGV4dCwgdG9rZW4gPSAibmdyYW1zIiwgbiA9IDIpDQoNCmJpZ3JhbV9jb3VudHMgPC0gaG1fYmlncmFtcyAlPiUNCiAgc2VwYXJhdGUoYmlncmFtLCBjKCJ3b3JkMSIsICJ3b3JkMiIpLCBzZXAgPSAiICIpICU+JQ0KICBjb3VudCh3b3JkMSwgd29yZDIsIHNvcnQgPSBUUlVFKQ0KYGBgDQoNCiMjIyBTcGVjaWZ5IHRoZSB1c2VyIGludGVyZmFjZSBmb3IgdGhlIFIgU2hpbnkgYXBwDQoNCldlIHdhbnQgZWFjaCB0YWIgdG8gaGF2ZSBpdHMgb3duIGNvbnRyb2xzIGZvciBpbnB1dCBhbmQgc28gU2hpbnkncyAibmF2YmFyUGFnZSgpIiBsYXlvdXQgd29ya3MgdGhlIGJlc3QuIFdlIGhhdmUgdGhlIGZpcnN0IHRhYiB2aXN1YWxpemluZyB0aGUgb3ZlcmFsbCBkYXRhLCBzZWNvbmQgb25lIGZvciBzY2F0dGVycGxvdHMgY29tcGFyaW5nIHRoZSBwcm9wb3J0aW9uIG9mIHdvcmRzIHdpdGhpbiBjYXRlZ29yaWVzLCB0aGlyZCBvbmUgaGlnaGxpZ2h0aW5nIHRoZSBtb3N0IGZyZXF1ZW50bHkgYXBwZWFyaW5nIGJpZ3JhbXMgYmFzZWQgb24gY2F0ZWdvcmllcyBhbmQgdGhlIGxhc3QgdGFiIHRvIGV4cGxvcmUgdGhlIGFjdHVhbCBoYXBweSBtb21lbnRzLg0KDQpgYGB7ciBzaGlueSBVSSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCnVpIDwtIG5hdmJhclBhZ2UoIldoYXQgbWFrZXMgcGVvcGxlIGhhcHB5PyIsDQogICAgICAgICAgICAgICAgIHRhYlBhbmVsKCJPdmVydmlldyIsDQogICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICB0aXRsZVBhbmVsKGgxKCJNb3N0IEZyZXF1ZW50IE9jY3VycmVuY2VzIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBhbGlnbiA9ICJjZW50ZXIiKSksDQogICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICBzaWRlYmFyTGF5b3V0KA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNpZGViYXJQYW5lbCgNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNsaWRlcklucHV0KGlucHV0SWQgPSAidG9wV29yZGNsb3VkIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxhYmVsID0gIk51bWJlciBvZiB0ZXJtcyBmb3Igd29yZCBjbG91ZDoiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWluID0gNSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1heCA9IDEwMCwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlID0gNTApLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYnIoKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGJyKCksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNoZWNrYm94SW5wdXQoaW5wdXRJZCA9ICJ0b3BGcmVxQiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxhYmVsID0gIlBsb3QgQmFyIENoYXJ0IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdmFsdWUgPSBGKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNsaWRlcklucHV0KGlucHV0SWQgPSAidG9wQmFyY2hhcnQiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiTnVtYmVyIG9mIHRlcm1zIGZvciBiYXIgY2hhcnQ6IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1pbiA9IDEsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtYXggPSAyNSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlID0gMTApLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYnIoKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGJyKCksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNoZWNrYm94SW5wdXQoaW5wdXRJZCA9ICJ0b3BGcmVxTiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxhYmVsID0gIlBsb3QgTmV0d29yayBHcmFwaCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlID0gRiksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBzbGlkZXJJbnB1dChpbnB1dElkID0gInRvcE5ldHdvcmsiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiTnVtYmVyIG9mIGVkZ2VzIGZvciBuZXR3b3JrIGdyYXBoOiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtaW4gPSAxLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4ID0gMTUwLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdmFsdWUgPSA1MCkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICApLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1haW5QYW5lbCgNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHdvcmRjbG91ZDJPdXRwdXQob3V0cHV0SWQgPSAiV0MiKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsb3RPdXRwdXQob3V0cHV0SWQgPSAiZmlndXJlIikNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICApDQogICAgICAgICAgICAgICAgICAgICAgICAgICkNCiAgICAgICAgICAgICAgICAgKSwNCiAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgIHRhYlBhbmVsKCJJbmRpdmlkdWFsIFRlcm1zIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHRpdGxlUGFuZWwoaDEoIkNvbXBhcmlzb24gb2YgUHJvcG9ydGlvbnMiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGFsaWduID0gImNlbnRlciIpKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHNpZGViYXJMYXlvdXQoDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgc2lkZWJhclBhbmVsKA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2VsZWN0SW5wdXQoaW5wdXRJZCA9ICJhdHRyaWJ1dGUiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiU2VsZWN0IHRoZSBhdHRyaWJ1dGU6IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNob2ljZXMgPSBjKCJHZW5kZXIiID0gImdlbmRlciIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiTWFyaXRhbCBTdGF0dXMiID0gIm1hcml0YWwiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlBhcmVudGhvb2QiID0gInBhcmVudGhvb2QiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlJlZmxlY3Rpb24gUGVyaW9kIiA9ICJyZWZsZWN0aW9uX3BlcmlvZCIpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICApDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICBtYWluUGFuZWwoDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbG90T3V0cHV0KG91dHB1dElkID0gInNjYXR0ZXIiKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KICAgICAgICAgICAgICAgICApLA0KICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgdGFiUGFuZWwoIlBhaXIgb2YgV29yZHMiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgdGl0bGVQYW5lbChoMSgiTW9zdCBGcmVxdWVudCBCaWdyYW1zIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBhbGlnbiA9ICJjZW50ZXIiKSksDQogICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICBzaWRlYmFyTGF5b3V0KA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNpZGViYXJQYW5lbCgNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNlbGVjdElucHV0KGlucHV0SWQgPSAiZmFjdG9yIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxhYmVsID0gIlNlbGVjdCB0aGUgYXR0cmlidXRlOiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjaG9pY2VzID0gYygiR2VuZGVyIiA9ICJnZW5kZXIiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIk1hcml0YWwgU3RhdHVzIiA9ICJtYXJpdGFsIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJQYXJlbnRob29kIiA9ICJwYXJlbnRob29kIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJSZWZsZWN0aW9uIFBlcmlvZCIgPSAicmVmbGVjdGlvbl9wZXJpb2QiKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG51bWVyaWNJbnB1dChpbnB1dElkID0gInRvcEJpZ3JhbXMiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiTnVtYmVyIG9mIHRvcCBwYWlycyB0byB2aWV3OiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtaW4gPSAxLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4ID0gMjUsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2YWx1ZSA9IDEwKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgbWFpblBhbmVsKA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgcGxvdE91dHB1dChvdXRwdXRJZCA9ICJiYXIiKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KICAgICAgICAgICAgICAgICApLA0KICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgdGFiUGFuZWwoIkRhdGEiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICBEVDo6ZGF0YVRhYmxlT3V0cHV0KCJ0YWJsZSIpDQogICAgICAgICAgICAgICAgICAgICAgICAgICkNCikNCmBgYA0KDQojIyMgRGV2ZWxvcCB0aGUgc2VydmVyIGZvciB0aGUgUiBTaGlueSBhcHANCg0KVGhpcyBzaGlueSBhcHAgdmlzdWFsaXplcyBzdW1tYXJ5IG9mIGRhdGEgYW5kIGRpc3BsYXlzIHRoZSBkYXRhIHRhYmxlIGl0c2VsZi4NCg0KYGBge3Igc2hpbnkgc2VydmVyLCB3YXJuaW5nPUZBTFNFLCBtZXNzYWdlPUZBTFNFfQ0Kc2VydmVyIDwtIGZ1bmN0aW9uKGlucHV0LCBvdXRwdXQsIHNlc3Npb24pIHsNCiAgDQogIHB0MSA8LSByZWFjdGl2ZSh7DQogICAgaWYoIWlucHV0JHRvcEZyZXFCKSByZXR1cm4oTlVMTCkNCiAgICB3b3JkX2NvdW50ICU+JQ0KICAgICAgc2xpY2UoMTppbnB1dCR0b3BCYXJjaGFydCkgJT4lDQogICAgICBtdXRhdGUod29yZCA9IHJlb3JkZXIod29yZCwgbikpICU+JQ0KICAgICAgZ2dwbG90KGFlcyh3b3JkLCBuKSkgKw0KICAgICAgZ2VvbV9jb2woKSArDQogICAgICB4bGFiKE5VTEwpICsNCiAgICAgIHlsYWIoIldvcmQgRnJlcXVlbmN5IikrDQogICAgICBjb29yZF9mbGlwKCkNCiAgfSkNCiAgDQogIHB0MiA8LSByZWFjdGl2ZSh7DQogICAgaWYoIWlucHV0JHRvcEZyZXFOKSByZXR1cm4oTlVMTCkNCiAgICBiaWdyYW1fZ3JhcGggPC0gYmlncmFtX2NvdW50cyAlPiUNCiAgICAgIHNsaWNlKDE6aW5wdXQkdG9wTmV0d29yaykgJT4lDQogICAgICBncmFwaF9mcm9tX2RhdGFfZnJhbWUoKQ0KICAgIA0KICAgIHNldC5zZWVkKDEyMykNCiAgICANCiAgICB4IDwtIGdyaWQ6OmFycm93KHR5cGUgPSAiY2xvc2VkIiwgbGVuZ3RoID0gdW5pdCguMSwgImluY2hlcyIpKQ0KICAgIA0KICAgIGdncmFwaChiaWdyYW1fZ3JhcGgsIGxheW91dCA9ICJmciIpICsNCiAgICAgIGdlb21fZWRnZV9saW5rKGFlcyhlZGdlX2FscGhhID0gbiksIHNob3cubGVnZW5kID0gRkFMU0UsDQogICAgICAgICAgICAgICAgICAgICBhcnJvdyA9IHgsIGVuZF9jYXAgPSBjaXJjbGUoLjA1LCAnaW5jaGVzJykpICsNCiAgICAgIGdlb21fbm9kZV9wb2ludChjb2xvciA9ICJza3libHVlIiwgc2l6ZSA9IDMpICsNCiAgICAgIGdlb21fbm9kZV90ZXh0KGFlcyhsYWJlbCA9IG5hbWUpLCByZXBlbCA9IFRSVUUpICsNCiAgICAgIHRoZW1lX3ZvaWQoKQ0KICB9KQ0KICANCiAgb3V0cHV0JFdDIDwtIHJlbmRlcldvcmRjbG91ZDIoew0KICAgIA0KICAgIHdvcmRfY291bnQgJT4lDQogICAgICBzbGljZSgxOmlucHV0JHRvcFdvcmRjbG91ZCkgJT4lDQogICAgICB3b3JkY2xvdWQyKHNpemUgPSAwLjYsDQogICAgICAgICAgICAgICAgIHJvdGF0ZVJhdGlvID0gMCkNCiAgICANCiAgfSkNCiAgDQogIG91dHB1dCRmaWd1cmUgPC0gcmVuZGVyUGxvdChoZWlnaHQgPSA1MDAsIHdpZHRoID0gNTAwLCB7DQogICAgDQogICAgcHRsaXN0IDwtIGxpc3QocHQxKCkscHQyKCkpDQogICAgcHRsaXN0IDwtIHB0bGlzdFshc2FwcGx5KHB0bGlzdCwgaXMubnVsbCldDQogICAgaWYobGVuZ3RoKHB0bGlzdCk9PTApIHJldHVybihOVUxMKQ0KICAgIA0KICAgIGxheSA8LSByYmluZChjKDEsMSksDQogICAgICAgICAgICAgICAgIGMoMiwyKSkNCiAgICANCiAgICBncmlkLmFycmFuZ2UoZ3JvYnMgPSBwdGxpc3QsIGxheW91dF9tYXRyaXggPSBsYXkpDQogIH0pDQogIA0KICANCiAgDQogIHNlbGVjdGVkQXR0cmlidXRlIDwtIHJlYWN0aXZlKHsNCiAgICBsaXN0KGF0ciA9IGlucHV0JGF0dHJpYnV0ZSkNCiAgfSkNCiAgDQogIG91dHB1dCRzY2F0dGVyIDwtIHJlbmRlclBsb3Qoew0KICAgIHRlbXAgPC0gYmFnX29mX3dvcmRzICU+JQ0KICAgICAgY291bnQoISFhcy5uYW1lKHNlbGVjdGVkQXR0cmlidXRlKCkkYXRyKSwgd29yZCkgJT4lDQogICAgICBncm91cF9ieSghIWFzLm5hbWUoc2VsZWN0ZWRBdHRyaWJ1dGUoKSRhdHIpKSAlPiUNCiAgICAgIG11dGF0ZShwcm9wb3J0aW9uID0gbiAvIHN1bShuKSkgJT4lIA0KICAgICAgc2VsZWN0KC1uKSAlPiUgDQogICAgICBzcHJlYWQoISFhcy5uYW1lKHNlbGVjdGVkQXR0cmlidXRlKCkkYXRyKSwgcHJvcG9ydGlvbikNCiAgICANCiAgICAgIGdncGxvdCh0ZW1wLCANCiAgICAgICAgICAgICBhZXNfc3RyaW5nKHggPSBjb2xuYW1lcyh0ZW1wKVsyXSwgeSA9IGNvbG5hbWVzKHRlbXApWzNdKSwNCiAgICAgICAgICAgICBjb2xvciA9IGFicyhjb2xuYW1lcyh0ZW1wKVszXSAtIGNvbG5hbWVzKHRlbXApWzJdKSkgKw0KICAgICAgZ2VvbV9hYmxpbmUoY29sb3IgPSAiZ3JheTQwIiwgbHR5ID0gMikgKw0KICAgICAgZ2VvbV9qaXR0ZXIoYWxwaGEgPSAwLjEsIHNpemUgPSAxLCB3aWR0aCA9IDAuMywgaGVpZ2h0ID0gMC4zKSArDQogICAgICBnZW9tX3RleHQoYWVzKGxhYmVsID0gd29yZCksIGNoZWNrX292ZXJsYXAgPSBUUlVFLCB2anVzdCA9IDEuNSkgKw0KICAgICAgc2NhbGVfeF9sb2cxMChsYWJlbHMgPSBwZXJjZW50X2Zvcm1hdCgpKSArDQogICAgICBzY2FsZV95X2xvZzEwKGxhYmVscyA9IHBlcmNlbnRfZm9ybWF0KCkpICsNCiAgICAgIHNjYWxlX2NvbG9yX2dyYWRpZW50KGxpbWl0cyA9IGMoMCwgMC4wMDEpLCBsb3cgPSAiZGFya3NsYXRlZ3JheTQiLCBoaWdoID0gImdyYXk3NSIpICsNCiAgICAgIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpDQogIH0pDQogIA0KICANCiAgDQogIHNlbGVjdGVkQmlncmFtIDwtIHJlYWN0aXZlKHsNCiAgICBsaXN0KHZhciA9IGlucHV0JGZhY3RvcikNCiAgfSkNCiAgDQogIG91dHB1dCRiYXIgPC0gcmVuZGVyUGxvdCh7DQogICAgaG1fYmlncmFtcyAlPiUNCiAgICAgIGNvdW50KCEhYXMubmFtZShzZWxlY3RlZEJpZ3JhbSgpJHZhciksIGJpZ3JhbSwgc29ydCA9IFRSVUUpICU+JQ0KICAgICAgZ3JvdXBfYnkoISFhcy5uYW1lKHNlbGVjdGVkQmlncmFtKCkkdmFyKSkgJT4lDQogICAgICB0b3BfbihpbnB1dCR0b3BCaWdyYW1zKSAlPiUNCiAgICAgIHVuZ3JvdXAoKSAlPiUNCiAgICAgIG11dGF0ZShiaWdyYW0gPSByZW9yZGVyKGJpZ3JhbSwgbikpICU+JQ0KICAgICAgZ2dwbG90KGFlcyhiaWdyYW0sIG4sIGZpbGwgPSAhIWFzLm5hbWUoc2VsZWN0ZWRCaWdyYW0oKSR2YXIpKSkgKw0KICAgICAgZ2VvbV9jb2woc2hvdy5sZWdlbmQgPSBGQUxTRSkgKw0KICAgICAgZmFjZXRfd3JhcChhcy5mb3JtdWxhKHBhc3RlKCJ+Iiwgc2VsZWN0ZWRCaWdyYW0oKSR2YXIpKSwgbmNvbCA9IDIsIHNjYWxlcyA9ICJmcmVlIikgKw0KICAgICAgY29vcmRfZmxpcCgpDQogIH0pDQogIA0KICANCiAgb3V0cHV0JHRhYmxlIDwtIERUOjpyZW5kZXJEYXRhVGFibGUoew0KICAgIERUOjpkYXRhdGFibGUoaG1fZGF0YSkNCiAgfSkNCn0NCmBgYA0KDQojIyMgUnVuIHRoZSBSIFNoaW55IGFwcA0KDQpgYGB7ciBzaGlueSBhcHAsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9DQpzaGlueUFwcCh1aSwgc2VydmVyKQ0KYGBgDQo=